home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
qbbs
/
qbwrtmsg.zip
/
QBWRTMSG.BAS
Wrap
BASIC Source File
|
1991-02-09
|
9KB
|
303 lines
' ------------------------------------------------------------------------
' QB 4.5 code for writing a QuickBBS msg base style msg.
' By Mark E. Moran
' (c) copyright 1991
' 1:273/603 Fidonet
' I make no guarantees on this code other than it'll take up disk space.
' IE., use it at your OWN risk (BACKUP MSG*.BBS BEFORE you use this!)
' You may use this code as you you wish, for free, but I do retain
' a copyright on it. This means you can't sell it, or redistribute it.
' If you do make improvements on this code I'd like to see them. You
' can send them or any comments to the above FIDONET address.
' Special thanks to Mike Janke, who's QBSTRUCT.BAS gave me most of the
' file structure types
' ------------------------------------------------------------------------
TYPE MsgIdx ' MSGIDX.BBS
MsgNum AS INTEGER
BoardNum AS STRING * 1
END TYPE
TYPE HdrRecord ' MSGHDR.BBS
msgnumb AS INTEGER
replyto AS INTEGER
seealso AS INTEGER
tread AS INTEGER
startrec1 AS STRING * 1 ' Kludge because QB can't handle
startrec2 AS STRING * 1 ' unsigned integers
numrecs AS INTEGER
destnet AS INTEGER
destnode AS INTEGER
orignet AS INTEGER
orignode AS INTEGER
destzone AS STRING * 1
origzone AS STRING * 1
cost AS INTEGER
msgattr AS STRING * 1
netattr AS STRING * 1
board AS STRING * 1
lenposttime AS STRING * 1
posttime AS STRING * 5
lenpostdate AS STRING * 1
postdate AS STRING * 8
lenwhoto AS STRING * 1
whoto AS STRING * 35
lenwhofrom AS STRING * 1
whofrom AS STRING * 35
lensubj AS STRING * 1
subj AS STRING * 72
END TYPE
TYPE MsgText ' MSGTXT.BBS
lineleng AS STRING * 1
lines AS STRING * 255
END TYPE
TYPE MsgToIdx ' MSGIDX.BBS
NameLen AS STRING * 1
ToWho AS STRING * 35
END TYPE
TYPE MsgInfo ' MSGINFO.BBS
lowmsg AS INTEGER
himsg AS INTEGER
totalmsg AS INTEGER
nummsgs AS INTEGER
'nummsgs1 as integer
'nummsgs2 as integer
somestuf AS STRING * 197 'You can't type an array in QB as you can
morestuf AS STRING * 197 'with Pascal, so to use the pascal
'ARRAY[1..200] OF INTEGER you would have
' to list 200 individual "Variable As Integer"
' in this type definition.
' Each stores the total msgs for the 200 possible
' msg areas
END TYPE
TYPE Config ' CONFIG.BBS
CommPort AS INTEGER
InitBaud AS INTEGER
InitTimes AS INTEGER
AnswerWait AS INTEGER
ModemInitStrlen AS STRING * 1
ModemInitStr AS STRING * 70
ModemBusyStrlen AS STRING * 1
ModemBusyStr AS STRING * 70
ModemInitResplen AS STRING * 1
ModemInitResp AS STRING * 40
ModemBusyResplen AS STRING * 1
ModemBusyResp AS STRING * 40
Resp300len AS STRING * 1
Resp300 AS STRING * 40
Resp1200len AS STRING * 1
Resp1200 AS STRING * 40
Resp2400len AS STRING * 1
Resp2400 AS STRING * 40
MenuPathlen AS STRING * 1
MenuPath AS STRING * 66
TextPathlen AS STRING * 1
TextPath AS STRING * 66
NetPathlen AS STRING * 1
NetPath AS STRING * 66
MinBaud AS INTEGER
GraphicsBaud AS INTEGER
XferBaud AS INTEGER
LowBaudStartlen AS STRING * 1
LowBaudStart AS STRING * 5
LowBaudEndlen AS STRING * 1
LowBaudEnd AS STRING * 5
DownloadStartlen AS STRING * 1
DownloadStart AS STRING * 5
DownloadEndlen AS STRING * 1
DownloadEnd AS STRING * 5
PagingStartlen AS STRING * 1
PagingStart AS STRING * 5
PagingEndlen AS STRING * 1
PagingEnd AS STRING * 5
MatrixZone AS INTEGER
MatrixNet AS INTEGER
MatrixNode AS INTEGER
AkaNet AS STRING * 5
AkaNode AS STRING * 5
NetMailBoard AS INTEGER
DefaultSec AS INTEGER
DefaultCredit AS INTEGER
DefaultFlags AS STRING * 14
EditorCmdStrlen AS STRING * 1
EditorCmdStr AS STRING * 70
OriginLinelen AS STRING * 1
OriginLine AS STRING * 60
SysopNamelen AS STRING * 1
SysopName AS STRING * 35
' Don't need the rest
END TYPE
DECLARE SUB Writemsg (ToWho$, Config AS ANY, msg$(), wnl%)
DIM Config AS Config, msg$(8), st$(8)
cg% = FREEFILE ' Read CONFIG.BBS
OPEN "F:\QBBS\CONFIG.BBS" FOR RANDOM ACCESS READ AS #cg% LEN = LEN(Config)
GET #cg%, 1, Config
CLOSE #cg%
' Text to be written
st$(1) = "Dear Mark,"
st$(2) = ""
st$(3) = "Thank you so very much for providing me with this great code."
st$(4) = "I realize it must have taken you many long hours to reverse"
st$(5) = "engineer all this. It is greatly appreciated."
st$(6) = ""
st$(7) = "Signed,"
st$(8) = "Indebted Programmer"
nl% = 8 'Total number of lines
' Each record in MSGTXT.BBS is 255 bytes long
' So we want to cram as much as we can in each record
' The following will fill up an ARRAY msg$() with your msg marking the
' end of each line with a CR/LF, but putting more than the usual 80 chars
' on a line in each variable
mnl% = 1
FOR x% = 1 TO nl%
spclft% = 255 - LEN(msg$(mnl%))
IF LEN(st$(nl%)) > spclft% THEN
msg$(mnl%) = msg$(mnl%) + LEFT$(st$(x%), spclft%)
mnl% = mnl% + 1
msg$(mnl%) = RIGHT$(st$(x%), LEN(st$(x%)) - spclft%)
ELSE
msg$(mnl%) = msg$(mnl%) + st$(x%)
END IF
' Add CR/LF
msg$(mnl%) = msg$(mnl%) + CHR$(13) + CHR$(10)
NEXT x%
msg$(0) = "Subject line"
Writemsg "Mark Moran", Config, msg$(), mnl%
SUB Writemsg (ToWho$, Config AS Config, msg$(), wnl%) STATIC
DIM HdrRecord AS HdrRecord
DIM MsgToIdx AS MsgToIdx
DIM MsgInfo AS MsgInfo
DIM MsgText AS MsgText
DIM MsgIdx AS MsgIdx
QBBSdir$ = "F:\QBBS\"
' Get high msg
mg% = FREEFILE
OPEN QBBSdir$ + "MSGINFO.BBS" FOR RANDOM AS #mg% LEN = LEN(MsgInfo)
GET #mg%, 1, MsgInfo
MsgInfo.himsg = MsgInfo.himsg + 1
MsgInfo.totalmsg = MsgInfo.totalmsg + 1
' Here you increase the total msg for the particular msg board
' This defaults to Msg area #1
' You have to add to the TYPE MSGINFO in the main module to write
' msg's to other boards (see the comment there.)
MsgInfo.nummsgs = MsgInfo.nummsgs + 1
PUT #mg%, 1, MsgInfo
CLOSE #mg%
mg% = FREEFILE
OPEN QBBSdir$ + "MSGTXT.BBS" FOR RANDOM AS #mg% LEN = LEN(MsgText)
msgtxtstart& = LOF(mg%) / LEN(MsgText) 'Get start position for msg text
' Write msgtxt.bbs
FOR x% = 1 TO wnl%
MsgText.lineleng = CHR$(LEN(msg$(x%)))
MsgText.lines = msg$(x%)
PUT #mg%, msgtxtstart& + x%, MsgText
NEXT x%
CLOSE #mg%
'Set variables for MSGHDR.BBS
HdrRecord.msgnumb = MsgInfo.himsg
HdrRecord.replyto = 0
HdrRecord.seealso = 0
HdrRecord.tread = 0
'Kludge to write an unsigned integer (0 to 65534)
HdrRecord.startrec1 = CHR$(msgtxtstart& MOD 256) ' Low
HdrRecord.startrec2 = CHR$(INT(msgtxtstart& / 256)) ' High
HdrRecord.numrecs = wnl% ' How many records this msg is
HdrRecord.destnet = Config.MatrixNet ' Defaults to your address
HdrRecord.destnode = Config.MatrixNode ' in config.sys
HdrRecord.orignet = Config.MatrixNet
HdrRecord.orignode = Config.MatrixNode
HdrRecord.destzone = CHR$(Config.MatrixZone)
HdrRecord.origzone = CHR$(Config.MatrixZone)
HdrRecord.cost = 0
HdrRecord.msgattr = CHR$(72) ' Set Private & Local Bits
' Msg Attributes: To Set add:
' Bit 0: Deleted 1
' Bit 1: Unmoved Outgoing Net Message 2
' Bit 2: Is a Net Mail Message 4
' Bit 3: Private 8
' Bit 4: Received 16
' Bit 5: Unmoved Outgoing Echo Message 32
' Bit 6: Local Bit 64
'
' EG., to mark a msg as Private and received you'd set it to: 16+8 or 24
HdrRecord.netattr = CHR$(0) ' This only writes echo msg areas
HdrRecord.board = "1" ' See comments in TYPE MSGINFO
HdrRecord.lenposttime = CHR$(5)
HdrRecord.posttime = LEFT$(TIME$, 5)
HdrRecord.lenpostdate = CHR$(8)
HdrRecord.postdate = LEFT$(DATE$, 6) + RIGHT$(DATE$, 2) ' FORMAT: 11-26-90
HdrRecord.lenwhoto = CHR$(LEN(ToWho$))
HdrRecord.whoto = ToWho$
HdrRecord.lenwhofrom = Config.SysopNamelen ' Defaults to SYSOP
HdrRecord.whofrom = LEFT$(Config.SysopName, ASC(Config.SysopNamelen))
HdrRecord.lensubj = CHR$(LEN(msg$(0)))
HdrRecord.subj = msg$(0)
' Write the msg header
mg% = FREEFILE
OPEN QBBSdir$ + "MSGHDR.BBS" FOR RANDOM AS #mg% LEN = LEN(HdrRecord)
num% = LOF(mg%) / LEN(HdrRecord) + 1
PUT #mg%, num%, HdrRecord
CLOSE #mg%
' Set info for 'to' index
MsgToIdx.NameLen = CHR$(LEN(ToWho$))
MsgToIdx.ToWho = ToWho$
' Write msgtoidx.bbs
mg% = FREEFILE
OPEN QBBSdir$ + "MSGTOIDX.BBS" FOR RANDOM AS #mg% LEN = LEN(MsgToIdx)
PUT #mg%, num%, MsgToIdx
CLOSE #mg%
' Set info for index
MsgIdx.MsgNum = MsgInfo.himsg
MsgIdx.BoardNum = CHR$(1)
'Write msgidx.bbs
mg% = FREEFILE
OPEN QBBSdir$ + "MSGIDX.BBS" FOR RANDOM AS #mg% LEN = LEN(MsgIdx)
PUT #mg%, num%, MsgIdx
CLOSE #mg%
END SUB